home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples2.0.Lha / Examples / NLMenu / NLMenu.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-09  |  7.2 KB  |  223 lines
  1. ''
  2. '' $Id: NLMenu.bas,v 1.9 1994/05/05 14:35:59 alex Rel $
  3. ''
  4. '' Show use of NewLook menus using Intuition, GadTools and Locale
  5. ''
  6. '' Derived from example (c) Copyright 1992 Commodore-Amiga, Inc.
  7. ''
  8.  
  9. DEFINT A-Z
  10. REM $NOWINDOW
  11. 'REM $INCLUDE Exec.bh
  12. 'REM $INCLUDE Locale.bh
  13. 'REM $INCLUDE Graphics.bh
  14. 'REM $INCLUDE DiskFont.bh
  15. 'REM $INCLUDE Intuition.bh
  16. 'REM $INCLUDE GadTools.bh
  17. 'REM $INCLUDE ASL.bh
  18. 'REM $INCLUDE Utility.bc
  19.  
  20. REM $INCLUDE BLib/GadToolsMenus.bas    ' gadtools menu builder helper
  21.  
  22. LIBRARY OPEN "exec.library", 36
  23. LIBRARY OPEN "graphics.library", LIBRARY_MINIMUM&
  24. LIBRARY OPEN "diskfont.library", LIBRARY_MINIMUM&
  25. LIBRARY OPEN "intuition.library", 36
  26. LIBRARY OPEN "gadtools.library", LIBRARY_MINIMUM&
  27. LIBRARY OPEN "asl.library", LIBRARY_MINIMUM&
  28.  
  29. REM $INCLUDE NLMenu_strings.bc    ' localized string IDs
  30. REM $INCLUDE NLMenu_strings.bas    ' default strings
  31. REM $INCLUDE BLib/GetCString.bas    ' localization helper
  32.  
  33. DIM SHARED tl&(40)    ' generic TagList; space for 20 tags
  34. DIM SHARED mysc&    ' default public screen
  35. DIM SHARED vi&        ' GadTools ViewInfo
  36. DIM SHARED dri&        ' screen DrawInfo
  37. DIM SHARED localeInfo&(2)    ' Localization info (if locale.library available)
  38.  
  39. DIM SHARED junk&
  40.  
  41. '
  42. ' liStr - function to simplify getting a localized string from the catalog
  43. '
  44. FUNCTION liStr$(BYVAL id&)
  45.     liStr$ = PEEK$(GetCString&(VARPTR(localeInfo&(0)), id&))
  46. END FUNCTION
  47.  
  48. '
  49. ' createMenuStrip - create a complete menu strip
  50. '
  51. FUNCTION createMenuStrip&(nmList&, BYVAL tattr&)
  52.     SHARED scaledcheck&, scaledamigakey&, vi&
  53.     STATIC nmEntry&, strip&
  54.  
  55.     createMenuStrip& = NULL&
  56.     nmList& = MenuAlloc&(nmEntry&, 19)    'space for 19 items (including the MenuEnd)
  57.     IF nmList& THEN
  58.         IF MenuTitle(nmEntry&, liStr$(MSG_PROJECT_MENU&), 0, NULL&) AND _
  59.           MenuItem(nmEntry&, liStr$(MSG_PROJECT_OPEN&), liStr$(MSG_PROJECT_OPEN_CK&), 0, 0, NULL&) AND _
  60.           MenuItem(nmEntry&, liStr$(MSG_PROJECT_SAVE&), liStr$(MSG_PROJECT_SAVE_CK&), 0, 0, NULL&) AND _
  61.           MenuItem(nmEntry&, "", "", 0, 0, NULL&) AND _
  62.           MenuItem(nmEntry&, liStr$(MSG_PROJECT_PRINT&), "", 0, 0, NULL&) AND _
  63.           MenuSubItem(nmEntry&, liStr$(MSG_PROJECT_PRINT_DRAFT&), liStr$(MSG_PROJECT_PRINT_DRAFT_CK&), CHECKIT& OR CHECKED&, NOT 1&, NULL&) AND _
  64.           MenuSubItem(nmEntry&, liStr$(MSG_PROJECT_PRINT_NLQ&), liStr$(MSG_PROJECT_PRINT_NLQ_CK&), CHECKIT&, NOT 2&, NULL&) AND _
  65.           MenuSubItem(nmEntry&, liStr$(MSG_PROJECT_PRINT_LASER&), liStr$(MSG_PROJECT_PRINT_LASER_CK&), CHECKIT&, NOT 4&, NULL&) AND _
  66.           MenuItem(nmEntry&, "", "", 0, 0, NULL&) AND _
  67.           MenuItem(nmEntry&, liStr$(MSG_PROJECT_QUIT&), liStr$(MSG_PROJECT_QUIT_CK&), 0, 0, NULL&) AND _
  68.           _
  69.           MenuTitle(nmEntry&, liStr$(MSG_EDIT_MENU&), 0, NULL&) AND _
  70.           MenuItem(nmEntry&, liStr$(MSG_EDIT_CUT&), liStr$(MSG_EDIT_CUT_CK&), 0, 0, NULL&) AND _
  71.           MenuItem(nmEntry&, liStr$(MSG_EDIT_COPY&), liStr$(MSG_EDIT_COPY_CK&), 0, 0, NULL&) AND _
  72.           MenuItem(nmEntry&, liStr$(MSG_EDIT_PASTE&), liStr$(MSG_EDIT_PASTE_CK&), 0, 0, NULL&) AND _
  73.           MenuItem(nmEntry&, "", "", 0, 0, NULL&) AND _
  74.           MenuItem(nmEntry&, liStr$(MSG_EDIT_ERASE&), liStr$(MSG_EDIT_ERASE_CK&), 0, 0, NULL&) AND _
  75.           MenuItem(nmEntry&, "", "", 0, 0, NULL&) AND _
  76.           MenuItem(nmEntry&, liStr$(MSG_EDIT_UNDO&), liStr$(MSG_EDIT_UNDO_CK&), 0, 0, NULL&) THEN
  77.             IF MenuEnd(nmEntry&, strip&, nmList&, tattr&, vi&, _
  78.               scaledcheck&, scaledamigakey&) THEN
  79.                 createMenuStrip& = strip&
  80.             ELSE
  81.                 MenuFree nmList&, strip&
  82.             END IF
  83.         ELSE
  84.             MenuFree nmList&, strip&
  85.         END IF
  86.     END IF
  87. END FUNCTION
  88.  
  89. SUB main
  90.     SHARED scaledcheck&, scaledamigakey&
  91.     STATIC strip&, tattr&, customfont&, win&, nmList&, fo&, done
  92.     STATIC imsg&, imsgClass&, imsgCode
  93.  
  94.     ' try to open the locale library (taking care to ignore errors)
  95.     LIBRARY VARPTR "locale.library", OpenLibrary&(SADD("locale.library" + CHR$(0)), 38)
  96.  
  97.     ' no problem if it doesn't open
  98.     localeInfo&(0) = LIBRARY("locale.library")
  99.     IF LIBRARY("locale.library") <> NULL& THEN
  100.         localeInfo&(1) = OpenCatalogA(NULL&, SADD("NLMenu.catalog" + CHR$(0)), NULL&)
  101.     END IF
  102.  
  103.     mysc& = LockPubScreen&(NULL&)    'lock the default public screen
  104.     IF mysc& THEN
  105.         vi& = GetVisualInfoA&(mysc&, NULL&)    'get GadTools visual info for the screen
  106.         IF vi& THEN
  107.             dri& = GetScreenDrawInfo&(mysc&)    'and screen DrawInfo
  108.             IF dri& THEN
  109.                 tattr& = PEEKL(mysc& + ScreenFont)    'default screen font
  110.  
  111.                 customfont& = 0
  112.                 scaledcheck& = 0
  113.                 scaledamigakey& = 0
  114.                 TAGLIST VARPTR(tl&(0)), _
  115.                   ASLFO_Screen&, mysc&, _
  116.                   ASLFO_InitialName&, PEEKL(tattr& + ta_Name), _
  117.                   ASLFO_InitialSize&, PEEKW(tattr& + ta_YSize), _
  118.                   ASLFO_MaxHeight&, 32767, _
  119.                   TAG_END&
  120.  
  121.  
  122.                 fo& = AllocAslRequest&(ASL_FontRequest&, VARPTR(tl&(0)))
  123.                 IF fo& THEN
  124.                     IF AslRequest&(fo&, NULL&) THEN
  125.                         tattr& = AllocMem&(TextAttr_sizeof, MEMF_CLEAR& OR MEMF_PUBLIC&)
  126.                         CopyMem fo& + fo_Attr, tattr&, TextAttr_sizeof
  127.                         POKEB tattr& + ta_Style, 0
  128.                         POKEB tattr& + ta_Flags, 0
  129.  
  130.                         customfont& = OpenDiskFont&(tattr&)
  131.  
  132.                         'Generate a custom checkmark whose size matches our custom font
  133.                         TAGLIST VARPTR(tl&(0)), _
  134.                           SYSIA_DrawInfo&, dri&, _
  135.                           SYSIA_Which&, MENUCHECK&, _
  136.                           SYSIA_ReferenceFont&, customfont&, _
  137.                           TAG_END&
  138.                         scaledcheck& = NewObjectA&(NULL&, SADD("sysiclass" + CHR$(0)), VARPTR(tl&(0)))
  139.  
  140.                         'Generate a custom Amiga-key image whose size matches our custom font
  141.                         TAGLIST VARPTR(tl&(0)), _
  142.                           SYSIA_DrawInfo&, dri&, _
  143.                           SYSIA_Which&, AMIGAKEY&, _
  144.                           SYSIA_ReferenceFont&, customfont&, _
  145.                           TAG_END&
  146.                         scaledamigakey& = NewObjectA&(NULL&, SADD("sysiclass" + CHR$(0)), VARPTR(tl&(0)))
  147.                     ELSE
  148.                         FreeAslRequest fo&
  149.                     END IF
  150.                 END IF
  151.  
  152.                 strip& = createMenuStrip&(nmList&, tattr&)
  153.  
  154.                 TAGLIST VARPTR(tl&(0)), _
  155.                   WA_Checkmark&, scaledcheck&, _
  156.                   WA_AmigaKey&, scaledamigakey&, _
  157.                   WA_Width&, 500, _
  158.                   WA_InnerHeight&, 100, _
  159.                   WA_Top&, 50, _
  160.                   WA_Activate&, TRUE&, _
  161.                   WA_DragBar&, TRUE&, _
  162.                   WA_DepthGadget&, TRUE&, _
  163.                   WA_CloseGadget&, TRUE&, _
  164.                   WA_SizeGadget&, TRUE&, _
  165.                   WA_SmartRefresh&, TRUE&, _
  166.                   WA_NoCareRefresh&, TRUE&, _
  167.                   WA_IDCMP&, IDCMP_CLOSEWINDOW& OR IDCMP_MENUPICK&, _
  168.                   WA_MinWidth&, 50, _
  169.                   WA_MinHeight&, 50, _
  170.                   WA_NewLookMenus&, TRUE&, _
  171.                   TAG_END&
  172.  
  173.                 IF scaledcheck& = NULL& OR scaledamigakey& = NULL& THEN
  174.                     'if you don't have these scaled, mark their tags as ignored
  175.  
  176.                     tl&(0) = TAG_IGNORE&
  177.                     tl&(2) = TAG_IGNORE&
  178.                 END IF
  179.  
  180.                 win& = OpenWindowTagList&(NULL&, VARPTR(tl&(0)))
  181.                 junk& = SetMenuStrip&(win&, strip&)
  182.  
  183.                 done = FALSE&
  184.                 WHILE done = FALSE&
  185.                     imsg& = WaitPort&(PEEKL(win& + UserPort))
  186.                     DO
  187.                         imsg& = GetMsg&(PEEKL(win& + UserPort))
  188.                         IF imsg& = NULL& THEN EXIT DO
  189.                         imsgClass& = PEEKL(imsg& + Class)
  190.                         imsgCode = PEEKW(imsg& + IntuiMessageCode)
  191.                         ReplyMsg imsg&
  192.                         SELECT CASE imsgClass&
  193.                             CASE IDCMP_CLOSEWINDOW&
  194.                                 done = TRUE&
  195.                         END SELECT
  196.                     LOOP
  197.                 WEND
  198.  
  199.                 ClearMenuStrip win&
  200.                 CloseWindow win&
  201.                 MenuFree nmList&, strip&
  202.  
  203.                 IF customfont& THEN
  204.                     FreeAslRequest fo&
  205.                     FreeMem tattr&, TextAttr_sizeof
  206.                     CloseFont customfont&
  207.                     DisposeObject scaledamigakey&
  208.                     DisposeObject scaledcheck&
  209.                 END IF
  210.             END IF
  211.             FreeVisualInfo vi&
  212.         END IF
  213.         FreeScreenDrawInfo mysc&, dri&
  214.     END IF
  215.     UnlockPubScreen NULL&, mysc&
  216.     IF LIBRARY("locale.library") <> NULL& THEN
  217.         CloseCatalog localeInfo&(1)    ' CloseCatalog NULL& is safe
  218.     END IF
  219. END SUB
  220.  
  221. main
  222. END
  223.